home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / tk / tk.tcl < prev    next >
Text File  |  1995-07-21  |  12KB  |  316 lines
  1. # tk.tcl --
  2. #
  3. # Initialization script normally executed in the interpreter for each
  4. # Tk-based application.  Arranges class bindings for widgets.
  5. #
  6. # $Header: /user6/ouster/wish/library/RCS/tk.tcl,v 1.37 93/10/31 16:39:17 ouster Exp $ SPRITE (Berkeley)
  7. #
  8. # Copyright (c) 1992-1993 The Regents of the University of California.
  9. # All rights reserved.
  10. #
  11. # Permission is hereby granted, without written agreement and without
  12. # license or royalty fees, to use, copy, modify, and distribute this
  13. # software and its documentation for any purpose, provided that the
  14. # above copyright notice and the following two paragraphs appear in
  15. # all copies of this software.
  16. #
  17. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  18. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  19. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  20. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  21. #
  22. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  23. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  24. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  25. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  26. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  27.  
  28. # Insist on running with compatible versions of Tcl and Tk.
  29.  
  30. scan [info tclversion] "%d.%d" a b
  31. if {$a != 7} {
  32.     error "wrong version of Tcl loaded ([info tclversion]): need 7.x"
  33. }
  34. scan $tk_version "%d.%d" a b
  35. if {($a != 3) || ($b < 4)} {
  36.     error "wrong version of Tk loaded ($tk_version): need 3.4 or later"
  37. }
  38. unset a b
  39.  
  40. # Add Tk's directory to the end of the auto-load search path:
  41.  
  42. lappend auto_path $tk_library
  43.  
  44. # Turn off strict Motif look and feel as a default.
  45.  
  46. set tk_strictMotif 0
  47.  
  48. # ----------------------------------------------------------------------
  49. # Class bindings for various flavors of button widgets.  $tk_priv(window)
  50. # keeps track of the button containing the mouse $tk_priv(relief) saves
  51. # the original relief of the button so it can be restored when the mouse
  52. # button is released, and $tk_priv(buttonWindow) keeps track of the
  53. # window in which the mouse button was pressed.
  54. # ----------------------------------------------------------------------
  55.  
  56. bind Button <Any-Enter> {tk_butEnter %W}
  57. bind Button <Any-Leave> {tk_butLeave %W}
  58. bind Button <1> {tk_butDown %W}
  59. bind Button <ButtonRelease-1> {tk_butUp %W}
  60.  
  61. bind Checkbutton <Any-Enter> {tk_butEnter %W}
  62. bind Checkbutton <Any-Leave> {tk_butLeave %W}
  63. bind Checkbutton <1> {tk_butDown %W}
  64. bind Checkbutton <ButtonRelease-1> {tk_butUp %W}
  65.  
  66. bind Radiobutton <Any-Enter> {tk_butEnter %W}
  67. bind Radiobutton <Any-Leave> {tk_butLeave %W}
  68. bind Radiobutton <1> {tk_butDown %W}
  69. bind Radiobutton <ButtonRelease-1> {tk_butUp %W}
  70.  
  71. # ----------------------------------------------------------------------
  72. # Class bindings for entry widgets.
  73. # ----------------------------------------------------------------------
  74.  
  75. bind Entry <1> {
  76.     %W icursor @%x
  77.     %W select from @%x
  78.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  79. }
  80. bind Entry <B1-Motion> {%W select to @%x}
  81. bind Entry <Shift-1> {%W select adjust @%x}
  82. bind Entry <Shift-B1-Motion> {%W select to @%x}
  83. bind Entry <2> {%W scan mark %x}
  84. bind Entry <B2-Motion> {%W scan dragto %x}
  85. bind Entry <Any-KeyPress> {
  86.     if {"%A" != ""} {
  87.     %W insert insert %A
  88.     tk_entrySeeCaret %W
  89.     }
  90. }
  91. bind Entry <Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  92. bind Entry <BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  93. bind Entry <Control-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  94. bind Entry <Control-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}
  95. bind Entry <Control-u> {%W delete 0 end}
  96. bind Entry <Control-v> {%W insert insert [selection get]; tk_entrySeeCaret %W}
  97. bind Entry <Control-w> {tk_entryBackword %W; tk_entrySeeCaret %W}
  98. tk_bindForTraversal Entry
  99.  
  100. # ----------------------------------------------------------------------
  101. # Class bindings for listbox widgets.
  102. # ----------------------------------------------------------------------
  103.  
  104. bind Listbox <1> {%W select from [%W nearest %y]}
  105. bind Listbox <B1-Motion> {%W select to [%W nearest %y]}
  106. bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}
  107. bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}
  108. bind Listbox <2> {%W scan mark %x %y}
  109. bind Listbox <B2-Motion> {%W scan dragto %x %y}
  110.  
  111. # ----------------------------------------------------------------------
  112. # Class bindings for scrollbar widgets.  When strict Motif is requested,
  113. # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
  114. # -activeforeground color to -foreground when the mouse is in the window
  115. # and restore it when the mouse leaves.
  116. # ----------------------------------------------------------------------
  117.  
  118. bind Scrollbar <Any-Enter> {
  119.     if $tk_strictMotif {
  120.     set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
  121.     %W config -activeforeground [lindex [%W config -foreground] 4]
  122.     }
  123. }
  124. bind Scrollbar <Any-Leave> {
  125.     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
  126.     %W config -activeforeground $tk_priv(activeFg)
  127.     }
  128. }
  129. bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}
  130. bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}
  131.  
  132. # ----------------------------------------------------------------------
  133. # Class bindings for scale widgets.  When strict Motif is requested,
  134. # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
  135. # -activeforeground color to -foreground when the mouse is in the window
  136. # and restore it when the mouse leaves.
  137. # ----------------------------------------------------------------------
  138.  
  139. bind Scale <Any-Enter> {
  140.     if $tk_strictMotif {
  141.     set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
  142.     %W config -activeforeground [lindex [%W config -sliderforeground] 4]
  143.     }
  144. }
  145. bind Scale <Any-Leave> {
  146.     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
  147.     %W config -activeforeground $tk_priv(activeFg)
  148.     }
  149. }
  150. bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}
  151. bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}
  152.  
  153. # ----------------------------------------------------------------------
  154. # Class bindings for menubutton widgets.  Variables used:
  155. # $tk_priv(posted) -        keeps track of the menubutton whose menu is
  156. #                currently posted (or empty string, if none).
  157. # $tk_priv(inMenuButton)-    if non-null, identifies menu button
  158. #                containing mouse pointer.
  159. # $tk_priv(relief) -        keeps track of original relief of posted
  160. #                menu button, so it can be restored later.
  161. # $tk_priv(dragging) -        if non-null, identifies menu button whose
  162. #                menu is currently being dragged in a tear-off
  163. #                operation.
  164. # $tk_priv(focus) -        records old focus window so focus can be
  165. #                returned there after keyboard traversal
  166. #                to menu.
  167. # ----------------------------------------------------------------------
  168.  
  169. bind Menubutton <Any-Enter> {
  170.     set tk_priv(inMenuButton) %W
  171.     if {[lindex [%W config -state] 4] != "disabled"} {
  172.     if {!$tk_strictMotif} {
  173.         %W config -state active
  174.     }
  175.     }
  176. }
  177. bind Menubutton <Any-Leave> {
  178.     set tk_priv(inMenuButton) {}
  179.     if {[lindex [%W config -state] 4] == "active"} {
  180.     %W config -state normal
  181.     }
  182. }
  183. bind Menubutton <1> {tk_mbButtonDown %W}
  184. bind Menubutton <Any-ButtonRelease-1> {
  185.     if {($tk_priv(posted) == "%W") && ($tk_priv(inMenuButton) == "%W")} {
  186.     [lindex [$tk_priv(posted) config -menu] 4] activate 0
  187.     } else {
  188.     tk_mbUnpost
  189.     }
  190. }
  191.  
  192. # The binding below is trickier than it looks.  It's important to check
  193. # to see that another menu is posted in the "if" statement below.
  194. # The check is needed because some window managers (e.g. mwm in
  195. # click-to-focus mode) cause a button-press event to be preceded by
  196. # a B1-Enter event;  we don't want to process that B1-Enter event (if
  197. # we do, the grab may get mis-set so that the menu is non-responsive).
  198.  
  199. bind Menubutton <B1-Enter> {
  200.     set tk_priv(inMenuButton) %W
  201.     if {([lindex [%W config -state] 4] != "disabled")
  202.         && ($tk_priv(posted) != "")} {
  203.     if {!$tk_strictMotif} {
  204.         %W config -state active
  205.     }
  206.     tk_mbPost %W
  207.     }
  208. }
  209. bind Menubutton <2> {
  210.     if {($tk_priv(posted) == "")
  211.         && ([lindex [%W config -state] 4] != "disabled")} {
  212.     set tk_priv(dragging) %W
  213.     [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
  214.     }
  215. }
  216. bind Menubutton <B2-Motion> {
  217.     if {$tk_priv(dragging) != ""} {
  218.     [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
  219.     }
  220. }
  221. bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) ""}
  222.  
  223. # ----------------------------------------------------------------------
  224. # Class bindings for menu widgets.  $tk_priv(x) and $tk_priv(y) are used
  225. # to keep track of the position of the mouse cursor in the menu window
  226. # during dragging of tear-off menus.  $tk_priv(window) keeps track of
  227. # the menu containing the mouse, if any.
  228. # ----------------------------------------------------------------------
  229.  
  230. bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}
  231. bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}
  232. bind Menu <Any-Motion> {
  233.     if {$tk_priv(window) == "%W"} {
  234.     %W activate @%y
  235.     }
  236. }
  237. bind Menu <1> {
  238.     if {$tk_priv(grab) != ""} {
  239.     grab $tk_priv(grab)
  240.     }
  241. }
  242. bind Menu <ButtonRelease-1> {tk_invokeMenu %W}
  243. bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}
  244. bind Menu <B2-Motion> {
  245.     if {$tk_priv(posted) == ""} {
  246.     %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]
  247.     }
  248. }
  249. bind Menu <B2-Leave> { }
  250. bind Menu <B2-Enter> { }
  251. bind Menu <Escape> {tk_mbUnpost}
  252. bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}
  253. bind Menu <Left> {tk_nextMenu -1}
  254. bind Menu <Right> {tk_nextMenu 1}
  255. bind Menu <Up> {tk_nextMenuEntry -1}
  256. bind Menu <Down> {tk_nextMenuEntry 1}
  257. bind Menu <Return> {tk_invokeMenu %W}
  258.  
  259. # ----------------------------------------------------------------------
  260. # Class bindings for text widgets. $tk_priv(selectMode) holds one of
  261. # "char", "word", or "line" to indicate which selection mode is active.
  262. # ----------------------------------------------------------------------
  263.  
  264. bind Text <1> {
  265.     set tk_priv(selectMode) char
  266.     %W mark set insert @%x,%y
  267.     %W mark set anchor insert
  268.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  269. }
  270. bind Text <Double-1> {
  271.     set tk_priv(selectMode) word
  272.     %W mark set insert "@%x,%y wordstart"
  273.     tk_textSelectTo %W insert
  274. }
  275. bind Text <Triple-1> {
  276.     set tk_priv(selectMode) line
  277.     %W mark set insert "@%x,%y linestart"
  278.     tk_textSelectTo %W insert
  279. }
  280. bind Text <B1-Motion> {tk_textSelectTo %W @%x,%y}
  281. bind Text <Shift-1> {
  282.     tk_textResetAnchor %W @%x,%y
  283.     tk_textSelectTo %W @%x,%y
  284. }
  285. bind Text <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}
  286. bind Text <2> {%W scan mark %y}
  287. bind Text <B2-Motion> {%W scan dragto %y}
  288. bind Text <Any-KeyPress> {
  289.     if {"%A" != ""} {
  290.     %W insert insert %A
  291.     %W yview -pickplace insert
  292.     }
  293. }
  294. bind Text <Return> {%W insert insert \n; %W yview -pickplace insert}
  295. bind Text <BackSpace> {tk_textBackspace %W; %W yview -pickplace insert}
  296. bind Text <Delete> {tk_textBackspace %W; %W yview -pickplace insert}
  297. bind Text <Control-h> {tk_textBackspace %W; %W yview -pickplace insert}
  298. bind Text <Control-d> {%W delete sel.first sel.last}
  299. bind Text <Control-v> {
  300.     %W insert insert [selection get]
  301.     %W yview -pickplace insert
  302. }
  303. tk_bindForTraversal Text
  304.  
  305. # Initialize the elements of tk_priv that require initialization.
  306.  
  307. set tk_priv(buttons) 0
  308. set tk_priv(buttonWindow) {}
  309. set tk_priv(dragging) {}
  310. set tk_priv(focus) {}
  311. set tk_priv(grab) {}
  312. set tk_priv(inMenuButton) {}
  313. set tk_priv(posted) {}
  314. set tk_priv(selectMode) char
  315. set tk_priv(window) {}
  316.